home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel0_89.lha / Feel / Modules / plists.em < prev    next >
Lisp/Scheme  |  1993-07-12  |  2KB  |  59 lines
  1.  
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;                                                                           ;;
  4. ;;  EuLisp Module                     Copyright (C) University of Bath 1991  ;;
  5. ;;                                                                           ;;
  6. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  7.  
  8. (defmodule plists (standard0) ()
  9.  
  10.   (deflocal main-table (make <table> ))
  11.  
  12.   (defun put (id key val)
  13.     (let ((prop-table (or 
  14.                 (table-ref main-table id)
  15.             (progn
  16.               ((setter table-ref) main-table id (make <table>))
  17.               (table-ref main-table id)))))
  18.       ((setter table-ref) prop-table key val)
  19.       val))
  20.  
  21.   (export put)
  22.  
  23.   (defun get (id key)
  24.     (let ((tab (table-ref main-table id)))
  25.       (if (null tab) nil
  26.     (table-ref tab key))))
  27.  
  28.   (export get)
  29.  
  30.   ((setter setter) get put)
  31.  
  32.   (defun remprop (id key)
  33.     (let ((tab (table-ref main-table id)))
  34.       (if (null tab) nil
  35.     (let ((ans (table-ref tab key)))
  36.                     ; May be a new table
  37.       ;;((setter table-ref) main-table id (table-delete tab key))
  38.       ans))))
  39.  
  40.   (export remprop)
  41.  
  42.   (defun symbol-props (id)
  43.     (let ((tab (table-ref main-table id)))
  44.       (if (null tab) nil
  45.     (let ((ans nil))
  46.       (map-table
  47.          (lambda (tag prop) (setq ans (cons tag (cons prop ans))))
  48.          tab)
  49.       ans))))
  50.  
  51.   (defun table-delete (t x)
  52.     ((setter table-ref) t x nil))
  53.  
  54.   (defun kill-props (id)
  55.     ((setter table-ref) main-table id nil))
  56.  
  57.   (export symbol-props kill-props)
  58. )
  59.